home
***
CD-ROM
|
disk
|
FTP
|
other
***
search
/
Cream of the Crop 1
/
Cream of the Crop 1.iso
/
PROGRAM
/
GAUGE.ARJ
/
UTILS.PAS
< prev
Wrap
Pascal/Delphi Source File
|
1992-02-13
|
6KB
|
265 lines
{$N+}
unit Utils;
interface
uses
WinTypes, WinProcs, Strings, WinDOS;
type
DriveStr = array[0..2] of Char;
DriveRec = Record
dLetter : DriveStr;
dTotal : LongInt;
end;
var
avDrives : array[0..23] of DriveRec;
dChoice : Integer;
function GetHeapSpaces(hModule : THandle) : LongInt;
procedure heapInfo(module : PChar; var pfree, ptotal, ppercent : Word);
function GetFreeResources : LongInt;
procedure SetInternational;
procedure GetCurTime(var tTime : PChar);
procedure GetCurDate(var cDate : PChar);
function OneDriveInfo(drive : Integer; var total : LongInt) : Boolean;
function GetDriveInfo : Integer;
function GetFreeMemory : String;
procedure GetAvail(theDrive : Integer; total : LongInt;
var avail : LongInt; var ratio : Single);
implementation
var
iDate,
iTime : Integer;
sDate : array[0..1] of Char;
sTime : array[0..1] of Char;
sAMPM : array[0..1, 0..4] of Char;
(* ------------- Undocumented Windows function ---------------- *)
function GetHeapSpaces(hModule : THandle) : LongInt;
external 'KERNEL' index 138;
(* ------------------------------------------------------------- *)
procedure heapInfo(module : PChar; var pfree, ptotal, ppercent : Word);
var
info : LongInt;
begin
info := GetHeapSpaces(GetModuleHandle(module));
pfree := LoWord(info);
ptotal := Hiword(info);
info := Word((LongInt(pfree) * 100) div ptotal);
ppercent := info;
end;
function GetFreeResources : LongInt;
var
userFree,
userTotal,
userPercent,
gdiFree,
gdiTotal,
gdiPercent : Word;
begin
heapInfo('USER', userFree, userTotal, userPercent);
heapInfo('GDI', gdiFree, gdiTotal, gdiPercent);
GetFreeResources := MakeLong(userPercent, gdiPercent);
end;
procedure SetInternational;
const
cName = 'intl';
begin
iDate := GetProfileInt(cName, 'iDate', 0);
iTime := GetProfileInt(cName, 'iTime', 0);
GetProfileString(cName, 'sDate', '/', sDate, 2);
GetProfileString(cName, 'sTime', ':', sTime, 2);
GetProfileString(cName, 's1159', 'AM', sAMPM[0], 5);
GetProfileString(cName, 's2359', 'PM', sAMPM[1], 5);
end;
procedure GetCurTime(var tTime : PChar);
type
shTime = Record
shHr : Word;
shSep : array[0..1] of Char;
shMin : Word;
end;
lTime = Record
shHr : Word;
shSep : array[0..1] of Char;
shMin : Word;
ampm : PChar;
{ampm : array[0..4] of Char;}
end;
var
hr,
tmin,
sec,
hsec : Word;
shortTime : shTime;
longTime : lTime;
begin
GetTime(hr, tmin, sec, hsec);
with shortTime do begin
shHr := hr;
shMin := tmin;
StrCopy(shSep, sTime);
end;
with longTime do begin
shHr := hr;
shMin := tmin;
StrCopy(shSep, sTime);
GetMem(ampm, 5);
StrCopy(ampm, sAMPM[hr div 12]);
end;
if iTime = 1 then
begin
GetMem(tTime, 6);
wvsprintf(tTime, '%02d%c%02d', shortTime);
end
else begin
GetMem(tTime, 9);
if (hr mod 12) <> 0 then
longTime.shHr := hr mod 12
else
longTime.shHr := 12;
wvsprintf(tTime, '%02d%c%02d %s', longTime);
end;
FreeMem(longTime.ampm, 5);
end;
procedure GetCurDate(var cDate : PChar);
type
DateRec = Record
tday : Word;
sep1 : array[0..1] of Char;
month : Word;
sep2 : array[0..1] of Char;
year : Word;
end;
var
yr,
mo,
day,
dweek : Word;
lDate : DateRec;
begin
GetMem(cDate, 9);
{GetMem(lDate.sep1, 2);}
{GetMem(lDate.sep2, 2);}
GetDate(yr, mo, day, dweek);
yr := yr mod 100;
case iDate of
1 :
begin
with lDate do begin
tday := day;
month := mo;
year := yr;
StrCopy(sep1, sDate);
StrCopy(sep2, sDate);
end;
end;
2 :
begin
with lDate do begin
tday := yr;
month := mo;
year := day;
StrCopy(sep1, sDate);
StrCopy(sep2, sDate);
end;
end;
else begin
with lDate do begin
tday := mo;
month := day;
year := yr;
StrCopy(sep1, sDate);
StrCopy(sep2, sDate);
end;
end;
end;
wvsprintf(cDate, '%02d%c%02d%c%02d', lDate);
end;
function OneDriveInfo(drive : Integer; var total : LongInt) : Boolean;
var
dType : Word;
begin
OneDriveInfo := False;
total := 0;
dType := GetDriveType(drive - 1);
if (dType >= drive_Removable) then begin
OneDriveInfo := True;
total := DiskSize(drive) div 1024 div 1024;
end;
end;
function GetDriveInfo : Integer;
var
i, j : Integer;
Total : LongInt;
isOK : Boolean;
begin
i := 3;
j := -1;
isOK := True;
while isOK do begin
isOK := OneDriveInfo(i, Total);
if isOK then begin
if (Total <> 0) then begin
Inc(j);
with avDrives[j] do begin
dTotal := Total;
dLetter[0] := Chr(i + 64);
dLetter[1] := ':';
end;
Inc(i);
end
else
isOK := False;
end;
end;
GetDriveInfo := j;
end;
function GetFreeMemory : String;
var
dwFreeMem : LongInt;
curMem,
rMem : Real;
temp : String;
begin
dwFreeMem := GetFreeSpace(0);
curMem := dwFreeMem;
rMem := curMem / 1024.0 / 1024.0;
Str(rMem:5:2, temp);
GetFreeMemory := Concat(temp, ' Mb');
end;
procedure GetAvail(theDrive : Integer; total : LongInt;
var avail : LongInt; var ratio : Single);
begin
avail := DiskFree(theDrive + 3) div 1024 div 1024;
ratio := Single(avail) / Single(total);
end;
end.